home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGSCAL / TBUTIL2.LZH / PASCAPS.PAS < prev    next >
Pascal/Delphi Source File  |  1984-07-13  |  6KB  |  182 lines
  1. PROGRAM PasCaps;
  2.  
  3. {  This program converts the lower case Pascal identifiers in a source  }
  4. {  code file to upper case.                                             }
  5. {  Jeff Firestone.  June, 1984.                                         }
  6.  
  7. CONST
  8.   Idents1 = ' ARCTAN ASSIGN AUX AUXINPTR AUXOUTPTR BLOCKREAD BLOCKWRITE BOOLEAN BDOS ';
  9.   Idents2 = ' BUFLEN BYTE CHAIN CHAR CHR CLOSE CLREOL CLRSCR CON CONINPTR HALT BIOS ';
  10.   Idents3 = ' CONCAT CONSTPTR COPY COS CRTEXIT CRTINIT DELLINE DELAY DELETE LOWVIDEO ';
  11.   Idents4 = ' EOF EOLN ERASE EXECUTE EXP FALSE FILEPOS FILESIZE FILLCHAR FLUSH INTR ';
  12.   Idents5 = ' FRAC GETMEM GOTOXY HEAPPTR HI HIGHVIDEO IORESULT INPUT INSLINE INSERT ';
  13.   Idents6 = ' INT INTEGER KBD KEYPRESSED LENGTH LN LO LST LSTOUTPTR MARK MAXINT MEM ';
  14.   Idents7 = ' MEMAVAIL MOVE NEW NORMVIDEO ODD ORD OUTPUT PI PORT POS PRED PTR RANDOM ';
  15.   Idents8 = ' RANDOMIZE READ READLN REAL RELEASE RENAME RESET REWRITE ROUND SEEK SIN ';
  16.   Idents9 = ' SIZEOF SQR SQRT STR SUCC SWAP TEXT TRM TRUE TRUNC UPCASE USR USRINPTR';
  17.   Idents10= ' USROUTPTR VAL WRITE WRITELN ABSOLUTE AND ARRAY BEGIN CASE CONST DIV ADDR ';
  18.   Idents11= ' DO DOWNTO ELSE END EXTERNAL FILE FOR FORWARD FUNCTION GOTO IF IN COLOR ';
  19.   Idents12= ' INLINE LABEL MOD NIL NOT OF OR PACKED PROCEDURE PROGRAM RECORD REPEAT';
  20.   Idents13= ' SET SHL SHR STRING THEN TO TYPE UNTIL VAR WHILE WITH XOR OFS SEG MEM MEMW ';
  21.   Idents14= ' OVERLAY DISPOSE DRAW FREEMEM HIRES PALLETTE PLOT SOUND WINDOW MAXAVAIL ';
  22.   OpenBracket  = '{';
  23.   CloseBracket = '}';
  24.   OpenParen    = '(';
  25.   CloseParen   = ')';
  26.   Null         = '';
  27. TYPE
  28.   Caps = SET OF 'A'..'Z';
  29.   Nums = SET OF '0'..'9';
  30.   Strng = STRING[255];
  31. VAR
  32.   pntr, LineNum : INTEGER;
  33.   ProgLine, Name : STRING[255];
  34.   Word : STRING[100];
  35.   f1, f2 : TEXT;
  36.   Identifier: SET OF CHAR;
  37.  
  38.  
  39. PROCEDURE UpShift(VAR S: Strng);
  40. BEGIN
  41.   INLINE
  42.          ($C4/$BE/S/         {     LES   DI,S[BP]     }
  43.           $26/$8A/$0D/       {     MOV   CL,ES:[DI]   }
  44.           $FE/$C1/           {     INC   CL           }
  45.           $FE/$C9/           {L1:  DEC   CL           }
  46.           $74/$13/           {     JZ    L2           }
  47.           $47/               {     INC   DI           }
  48.           $26/$80/$3D/$61/   {     CMP   ES:BYTE PRT [DI],'a'}
  49.           $72/$F5/           {     JB    L1           }
  50.           $26/$80/$3D/$7A/   {     CMP   ES:BYTE PTR [DI],'z'}
  51.           $77/$EF/           {     JA    L1           }
  52.           $26/$80/$2D/$20/   {     SUB   ES:BYTE PRT [DI],20H}
  53.           $EB/$E9            {     JMP   SHORT L1     }
  54.                              {L2:                     });
  55. END;
  56.  
  57.  
  58. PROCEDURE Greeting;
  59. BEGIN
  60.   GOTOXY(23,1);
  61.   WRITELN('CAPITALIZE PASCAL IDENTIFIERS');
  62.   WRITELN;WRITELN;
  63.   WRITELN('This program reads a Pascal source file and capitalizes all the identifiers');
  64.   WRITELN('in that file.  The results are output to a file the users specifies.');
  65.   WRITELN;
  66.   WRITELN('The output file tends to be easier to read than one in which a hodge-podge');
  67.   WRITELN('of capitalized and lower case identifiers co-reside.  It is the prefered');
  68.   WRITELN('format for Pascal source code.');
  69.   WRITELN;
  70.   WRITELN('With this utility, you can type all your source code in lower case and then');
  71.   WRITELN('convert it to standard format later.  This manner of writing Pascal saves you');
  72.   WRITELN('considerable time and bother.');
  73.   WRITELN; WRITELN; WRITELN;
  74. END;
  75.  
  76.  
  77. PROCEDURE OpenFiles;
  78. BEGIN
  79.   WRITE('What is the name of the source code file (RETURN to end) : ');
  80.   READLN(name);
  81.   IF LENGTH(name) = 0 THEN halt;
  82.   IF (POS('.', name) = 0) THEN name:= name + '.pas';
  83.   ASSIGN(f1, name);
  84.   RESET(f1);
  85.   WRITE('Where do you want to output to be sent (RETURN for Screen) : ');
  86.   READLN(name); UpShift(Name);
  87.   IF LENGTH(name) = 0 THEN name:= 'CON:';
  88.   ASSIGN(f2, name);
  89.   REWRITE(f2);
  90.   WRITELN; WRITE('Capitalizing...');
  91. END;
  92.  
  93.  
  94. PROCEDURE GetWord;
  95. VAR
  96.   TmpWord,TmpWrd : STRING[255];
  97.   GotIdent : INTEGER;
  98. BEGIN
  99.   Word:= '';
  100.   WHILE (UPCASE(ProgLine[pntr]) IN Identifier) AND
  101.         (pntr <= LENGTH(ProgLine)) DO
  102.              BEGIN
  103.                Word:= Word + ProgLine[pntr];
  104.                pntr:= pntr + 1;
  105.              END;
  106.  
  107.   TmpWrd:= Word; UpShift(TmpWrd);
  108.   TmpWord:= ' ' + TmpWrd + ' ';
  109.   GotIdent:= POS(TmpWord, Idents1) + POS(TmpWord, Idents2) +
  110.              POS(TmpWord, Idents3) + POS(TmpWord, Idents4) +
  111.              POS(TmpWord, Idents5) + POS(TmpWord, Idents6) +
  112.              POS(TmpWord, Idents7) + POS(TmpWord, Idents8) +
  113.              POS(TmpWord, Idents9) + POS(TmpWord, Idents10) +
  114.              POS(TmpWord, Idents11) + POS(TmpWord, Idents12) +
  115.              POS(TmpWord, Idents13) + POS(TmpWord, Idents14);
  116.   IF GotIdent > 0 THEN
  117.      WRITE(f2, TmpWrd)
  118.   ELSE
  119.      WRITE(f2, Word);
  120. END;
  121.  
  122.  
  123. PROCEDURE ScanTill(SearchChar: CHAR);
  124. BEGIN
  125.   REPEAT
  126.     WRITE(f2, ProgLine[pntr]);
  127.     pntr:= pntr + 1;
  128.     IF pntr > LENGTH(ProgLine) THEN
  129.     BEGIN
  130.       WRITELN(f2);
  131.       READLN(f1, ProgLine);
  132.       pntr:= 1;
  133.     END;
  134.   UNTIL (ProgLine[pntr] = SearchChar) OR EOF(f1);
  135.   WRITE(f2, ProgLine[pntr]);
  136.   pntr:= pntr + 1;
  137. END;
  138.  
  139.  
  140. PROCEDURE Convert;
  141. BEGIN
  142.   LineNum:= 0;
  143.   WHILE NOT EOF(f1) DO
  144.   BEGIN
  145.     pntr:= 1;
  146.     READLN(f1, ProgLine);
  147.     IF LENGTH(ProgLine) > 0 THEN
  148.     BEGIN
  149.     REPEAT
  150.       CASE UPCASE(ProgLine[pntr]) OF
  151.         'A'..'Z', '0'..'9', '_'  :  GetWord;
  152.         OpenBracket              :  ScanTill(CloseBracket);
  153.         ELSE
  154.           IF ProgLine[pntr] = #39 THEN
  155.             ScanTill(#39)
  156.           ELSE
  157.           BEGIN
  158.             WRITE(f2, ProgLine[pntr]);
  159.             pntr:= pntr + 1;
  160.           END;
  161.       END;  {  Case UpCase  }
  162.     UNTIL (pntr > LENGTH(ProgLine));
  163.     WRITELN(f2);
  164.     IF Name <> 'CON:' THEN
  165.       BEGIN
  166.         GOTOXY(4, 21);
  167.         WRITE(LineNum);
  168.         LineNum:= LineNum + 1;
  169.       END
  170.     END;
  171.     IF LENGTH(ProgLine) = 0 THEN WRITELN(f2);
  172.   END;  { WHILE }
  173.   CLOSE(f1); CLOSE(f2);
  174. END;
  175.  
  176. BEGIN
  177.   Identifier:= ['A'..'Z', '0'..'9', '_'];
  178.   Greeting;
  179.   OpenFiles;
  180.   Convert;
  181. END.
  182.